C     Program EX_0506.FOR
C     Listing 11F - see documentation in TUTOR.SSS

$include:'SSSF1.H'

      subroutine prime
$include:'SSSF2.H'
      integer ARRIVL, STARTA, ENDACT, NEXTAC, FINAL
      integer ecode, statn, rewkn
      logical debugf, busy, block
      real*8  defect, serial
      common  ARRIVL, STARTA, ENDACT, NEXTAC, FINAL,
     +  ecode, statn, rewkn, debugf, busy(3), block(3),
     +  defect(3), serial

      ARRIVL = 1
      STARTA = 2
      ENDACT = 3
      NEXTAC = 4
      FINAL  = 3

      debugf = .FALSE.
      serial = 1.0
      do 1 i=1, 3
      busy(i)  = .FALSE.
  1   block(i) = .FALSE.
      defect(1) = 0.3
      defect(2) = 0.2
      defect(3) = 0.1
 
      call INIQUE(3, 2, 3)
      call inista(1,'Prodt#1          ', 0, 0, 0.0, 0.0)
      call inista(2,'Prodt#2          ', 0, 0, 0.0, 0.0)
      call inista(3,'Prodt#3          ', 0, 0, 0.0, 0.0)
      call CREATE(0.0, 0)
      call SIMEND(6.0)
      return
      end

      subroutine deciph(i)
$include:'SSSF2.H'
      integer ARRIVL, STARTA, ENDACT, NEXTAC, FINAL
      integer ecode, statn, rewkn
      logical debugf, busy, block
      real*8  defect, serial
      common  ARRIVL, STARTA, ENDACT, NEXTAC, FINAL,
     +  ecode, statn, rewkn, debugf, busy(3), block(3),
     +  defect(3), serial
 
      statn = mod(i, 4)
      rewkn = int(i/4)
      return
      end

      subroutine triggr(i)
$include:'SSSF2.H'
      integer ARRIVL, STARTA, ENDACT, NEXTAC, FINAL
      integer ecode, statn, rewkn
      logical debugf, busy, block
      real*8  defect, serial
      common  ARRIVL, STARTA, ENDACT, NEXTAC, FINAL,
     +  ecode, statn, rewkn, debugf, busy(3), block(3),
     +  defect(3), serial

      call REMVFQ(i, 1)
      call SCHED(0, NEXTAC, IDE())
      if (i.gt.1) call CREATE(0.0, i-1)
      return
      end

      subroutine unblk(i)
$include:'SSSF2.H'
      integer ARRIVL, STARTA, ENDACT, NEXTAC, FINAL
      integer ecode, statn, rewkn
      logical debugf, busy, block
      real*8  defect, serial
      common  ARRIVL, STARTA, ENDACT, NEXTAC, FINAL,
     +  ecode, statn, rewkn, debugf, busy(3), block(3),
     +  defect(3), serial

      call DISPOS
      if (block(i)) then
        if ((NQ(i).gt.0).and.(.not.busy(i)))
     +    call triggr(i)
        block(i) = .FALSE.
      endif
      return
      end

      Program EX_0506
$include:'SSSF2.H'
      integer ARRIVL, STARTA, ENDACT, NEXTAC, FINAL
      integer ecode, statn, rewkn
      logical debugf, busy, block
      real*8  defect, serial
      common  ARRIVL, STARTA, ENDACT, NEXTAC, FINAL,
     +  ecode, statn, rewkn, debugf, busy(3), block(3),
     +  defect(3), serial
      character*1 sc
 
      call prime
   99 ecode = NEXTEV()
      if (ecode.gt.0) then
        goto (101, 102, 103, 104) ecode
 
C ARRIVL
  101   continue
        if (IDE().gt.0) then
          i = IDE()
          call unblk(i)
        else
 
          call CREATE(EX(0.5), 0)
          call SETA(1, RN(0.25, 0.05))
          call SETA(2, serial)
          serial = serial + 1.0
          call SCHED(0, NEXTAC, 1)
        endif
        goto 99
 
C NEXTAC
  104   continue
        i = IDE()
        call deciph(i)
 
        if (debugf)
     +    write(*,
     + '(A, F6.2, A, F2.0, A, F4.2, A, I1, A, I2, A\)')
     +    ' At ', T(), ' # ', A(2), ' for ', A(1),
     +    'h. to station # ', statn, ' for ', rewkn,
     +    ' rework'
 
        if (busy(statn).or.block(statn)) then
          call QUEUE(statn, 0.0)
          if (debugf) write(*, '(A)')' and waits'
          if ((NQ(statn).gt.4).and.(statn.gt.1))
     +      block(statn - 1) = .TRUE.
 
        else
          call SCHED(0.0, STARTA, IDE())
          if (debugf) then
            write(*, '(A\)') ' and processed'
            read(*, '(A1)') sc
            if ((sc.eq.'q').or.(sc.eq.'q')) stop
          endif
        endif
        goto 99
 
C STARTA
  102   continue
        i = IDE()
        call deciph(i)
        if (debugf) write(*, '(A, F6.2, A, F2.0, A)')
     +    ' At ', T(), ' #', A(2), ' starts work'
        if (rewkn.eq.0) call TALLY(statn, 1.0)
        busy(statn) = .TRUE.
        call SCHED(A(1), ENDACT, IDE())
        goto 99
 
C ENDACT
  103   continue
        i = IDE()
        call deciph(i)
        call TALLY(statn, 0.0)
 
        if (debugf) write(*, '(A, F6.2, A, F2.0, A\)')
     +    ' At ', T(), ' #', A(2), ' ends work'
        busy(statn) = .FALSE.
        if (RA().gt.defect(statn)) then
          if (statn.eq.FINAL) then
            call DISPOS()
            if(debugf) write(*, '(A)')' and discharged'
          else
 
            call SETA(1, RN(0.25, 0.05))
            call SCHED(0, NEXTAC, statn + 1)
            if (debugf) write(*, '(A)')' and goes on'
          endif
        else
 
          call SETA(1, A(1)/2)
          call SCHED(0.0, NEXTAC,
     +               statn + 4*(rewkn + 1))
          if (debugf) write(*, '(A)')' and recycled'
        endif
        if (debugf) write(*, '(A, F6.2, A, I2, A, I1)')
     + ' At ', T(), ' ', NQ(statn), ' are waiting at ',
     +    statn
        if (NQ(statn).gt.0) call triggr(statn)
        goto 99
 
      else
 
        call SUMRY(' ')
        stop 'End of simulation'
 
      endif
      end
 